home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / tcl / xf2.3-p / xf2 / xf2.3 / additionals / TkEmacs < prev    next >
Encoding:
Text File  |  1993-11-20  |  9.3 KB  |  285 lines
  1. # Program: xf
  2. # Description: handle text widgets
  3. #
  4. # $Header: TkEmacs[2.3] Wed Mar 10 11:57:33 1993 garfield@garfield frozen $
  5.  
  6. global xfDefaultConf
  7. set xfDefaultConf(tkemacs) 4
  8.  
  9. ##########
  10. # Procedure: XFAdd.TkEmacs
  11. # Description: add a tkEmacs
  12. # Arguments: xfW - the widget
  13. #            xfName - a optional name
  14. #            xfType - add or config
  15. # Returns: none
  16. # Sideeffects: none
  17. ##########
  18. proc XFAdd.TkEmacs {xfW xfName xfType} {
  19.   global xfFile
  20.   global xfStatus
  21.  
  22.   XFEditSetStatus "Inserting TkEmacs..."
  23.   set xfName [XFMiscGetUniqueName $xfName emacs]
  24.   set xfTmpOptions ""
  25.   if {"$xfFile(emacsCmd)" != ""} {
  26.     append xfTmpOptions " -command $xfFile(emacsCmd)"
  27.   }
  28.   if {"$xfFile(emacsLisp)" != ""} {
  29.     append xfTmpOptions " -lispfile $xfFile(emacsLisp)"
  30.   }
  31.   if {"$xfStatus(path)" == "."} {
  32.     if {[catch "tkemacs .$xfName $xfTmpOptions" xfResult]} {
  33.       XFProcError "$xfResult"
  34.       XFEditSetStatus "Inserting TkEmacs...aborted"
  35.       return
  36.     }
  37.  
  38.     XFMiscPositionWidget .$xfName
  39.     XFMiscBindWidgetTree .$xfName
  40.   } {
  41.     if {[catch "tkemacs $xfStatus(path).$xfName $xfTmpOptions" xfResult] != 0} {
  42.       XFProcError "$xfResult"
  43.       XFEditSetStatus "Inserting TkEmacs...aborted"
  44.       return
  45.     }
  46.  
  47.     XFMiscPositionWidget $xfStatus(path).$xfName
  48.     XFMiscBindWidgetTree $xfStatus(path).$xfName
  49.   }
  50.  
  51.   incr xfStatus(elementCounter)
  52.   XFEditSetPath $xfStatus(path)
  53.   XFEditSetStatus "Inserting TkEmacs...done"
  54. }
  55.  
  56. ##########
  57. # Procedure: XFAddTmp.TkEmacs
  58. # Description: add a tmp tkEmacs
  59. # Arguments: none
  60. # Returns: none
  61. # Sideeffects: none
  62. ##########
  63. proc XFAddTmp.TkEmacs {} {
  64. }
  65.  
  66. ##########
  67. # Procedure: XFConfig.TkEmacs4
  68. # Description: configure a tkEmacs
  69. # Arguments: xfW - the widget
  70. #            xfType - config type (add config)
  71. #            xfClass - the class we configure
  72. #            xfLeader - the leading window
  73. # Returns: none
  74. # Sideeffects: none
  75. ##########
  76. proc XFConfig.TkEmacs4 {xfW xfType xfClass {xfLeader ""}} {
  77.   global xfMisc
  78.   global xfStatus
  79.  
  80.   if {"$xfType" == "add"} {
  81.     set xfName emacs$xfStatus(elementCounter)
  82.   } {
  83.     set xfName [XFMiscPathName $xfW]
  84.   }
  85.   XFEditSetStatus "Calling parameter setting for TkEmacs..."
  86.  
  87.   # build widget structure
  88.   XFTmpltToplevel .xf${xfClass}Config4 400x440 \
  89.     "TkEmacs parameters:[XFMiscPathTail $xfW]" $xfLeader
  90.  
  91.   XFElementInit $xfW .xf${xfClass}Config4 $xfType $xfClass \
  92.     XFTkEmacsSetTkEmacs4 parameters $xfName 4
  93.   XFElementColor $xfW .xf${xfClass}Config4 $xfType $xfClass bg \
  94.     background Background "Background" XFTkEmacsSetTkEmacs4
  95.   XFElementText $xfW .xf${xfClass}Config4 $xfType $xfClass \
  96.     command command Command "Emacs command" \
  97.       XFTkEmacsSetTkEmacs4
  98.   XFElementText $xfW .xf${xfClass}Config4 $xfType $xfClass \
  99.     lispfile lispfile LispFile "Emacs lispfile" \
  100.       XFTkEmacsSetTkEmacs4
  101.   XFElementText $xfW .xf${xfClass}Config4 $xfType $xfClass \
  102.     file file File "File" XFTkEmacsSetTkEmacs4
  103.   XFElementFont $xfW .xf${xfClass}Config4 $xfType $xfClass \
  104.     font font Font "Font" XFTkEmacsSetTkEmacs4
  105.   XFElementColor $xfW .xf${xfClass}Config4 $xfType $xfClass fg \
  106.     foreground Foreground "Foreground" XFTkEmacsSetTkEmacs4
  107.   XFElementSize $xfW .xf${xfClass}Config4 $xfType $xfClass \
  108.     XFTkEmacsSetTkEmacs4
  109.   XFElementBoolean $xfW .xf${xfClass}Config4 $xfType $xfClass useAdvise \
  110.     "Use advise" XFTkEmacsSetTkEmacs4
  111.   XFElementText $xfW .xf${xfClass}Config4 $xfType $xfClass \
  112.     xscrollcommand xscrollcommand XScrollCommand "X scroll command" \
  113.       XFTkEmacsSetTkEmacs4
  114.   XFElementText $xfW .xf${xfClass}Config4 $xfType $xfClass \
  115.     yscrollcommand yscrollcommand YScrollCommand "Y scroll command" \
  116.       XFTkEmacsSetTkEmacs4
  117.   .xf${xfClass}Config4.params1.params2.size.size1.size1 conf -to 1000
  118.   .xf${xfClass}Config4.params1.params2.size.size2.size2 conf -to 1000
  119.  
  120.   # save current parameter
  121.   XFElementSave $xfW $xfClass {background command lispfile file font foreground height useadvise width xscrollcommand yscrollcommand}
  122.  
  123.   # packing
  124.   pack append .xf${xfClass}Config4.params1 \
  125.               .xf${xfClass}Config4.params1.params2 {left fill expand}
  126.   pack append .xf${xfClass}Config4 \
  127.               .xf${xfClass}Config4.pathname {top fill frame center} \
  128.               .xf${xfClass}Config4.leave {bottom fill} \
  129.               .xf${xfClass}Config4.additional {bottom fill} \
  130.               .xf${xfClass}Config4.params1 {top fill expand}
  131.  
  132.   XFBindFormConnect .xf${xfClass}Config4.params1.params2 \
  133.     "XFTkEmacsSetTkEmacs4 $xfW 0 $xfClass"
  134.  
  135.   XFEditSetStatus "Calling parameter setting for TkEmacs...done"
  136. }
  137.  
  138. ##########
  139. # Procedure: XFSaveSpecial.TkEmacs
  140. # Description: save tkEmacs
  141. # Arguments: xfW - the widget
  142. # Returns: none
  143. # Sideeffects: none
  144. ##########
  145. proc XFSaveSpecial.TkEmacs {xfW} {
  146.  
  147. #  puts $xfOutFile ""
  148. #  puts $xfOutFile "  $xfW insert end \{[XFMiscGetText $xfW]\}"
  149. }
  150.  
  151. ##########
  152. # Procedure: XFSaveWidget.TkEmacs
  153. # Description: save tkEmacs widget
  154. # Arguments: xfOutFile - the output file
  155. #            xfW - the widget
  156. # Returns: none
  157. # Sideeffects: none
  158. ##########
  159. proc XFSaveWidget.TkEmacs {xfOutFile xfW} {
  160.   global xfConf
  161.   global xfFile
  162.  
  163.   set xfType [string tolower [winfo class $xfW]]
  164.  
  165.   # what are we doing here ?
  166.   puts $xfOutFile "\n  # build widget $xfW"
  167.  
  168.   set xfTmpEmacsCmd [lindex [$xfW config -command] 4]
  169.   set xfTmpEmacsLisp [lindex [$xfW config -lispfile] 4]
  170.   set xfTmpEmacsNameCmd ""
  171.   if {![catch "lindex \[$xfW config -name\] 4" xfTmpEmacsName]} {
  172.     set xfTmpEmacsNameCmd "-name \\\"$xfTmpEmacsName\\\""
  173.   }
  174.   if {"$xfTmpEmacsCmd" == ""} {
  175.     set xfTmpEmacsCmd $xfFile(emacsCmd)
  176.   }
  177.   if {"$xfTmpEmacsLisp" == ""} {
  178.     set xfTmpEmacsLisp $xfFile(emacsLisp)
  179.   }
  180.   puts $xfOutFile "  if {\[catch \"tkemacs $xfW -command $xfTmpEmacsCmd -lispfile $xfTmpEmacsLisp $xfTmpEmacsNameCmd \"\]} {"
  181.   puts $xfOutFile "    if {\"\[info procs XFEdit\]\" != \"\"} {"
  182.   puts $xfOutFile "      XFProcError \"Unknown widget type: tkemacs\""
  183.   puts $xfOutFile "      return"
  184.   puts $xfOutFile "    } {"
  185.   puts $xfOutFile "      puts stderr \"Unknown widget type: tkemacs\""
  186.   puts $xfOutFile "      catch \"destroy .\""
  187.   puts $xfOutFile "      catch \"exit 0\""
  188.   puts $xfOutFile "    }"
  189.   puts $xfOutFile "  }"
  190.  
  191.   puts $xfOutFile "  $xfW config" nonewline
  192.   foreach xfCounter [$xfW config] {
  193.     # only handle options with 5 items per option entry
  194.     if {[llength $xfCounter] == 5} {
  195.       if {"[lindex $xfCounter 0]" == "-command" ||
  196.           "[lindex $xfCounter 0]" == "-lispfile" ||
  197.           "[lindex $xfCounter 0]" == "-name"} {
  198.         continue
  199.       }
  200.       if {("[lindex $xfCounter 0]" == "-scrollcommand" ||
  201.            "[lindex $xfCounter 0]" == "-xscrollcommand" ||
  202.            "[lindex $xfCounter 0]" == "-yscrollcommand") &&
  203.           "[lindex $xfCounter 4]" == "NoFunction"} {
  204.         continue
  205.       }
  206.       if {"[lindex $xfCounter 3]" != "[lindex $xfCounter 4]"} {
  207.         if {$xfConf(encloseConfigure)} {
  208.           puts $xfOutFile " \\\n    [lindex $xfCounter 0] {[lindex $xfCounter 4]}" nonewline
  209.         } {
  210.           puts $xfOutFile " \\\n    [lindex $xfCounter 0] \"[lindex $xfCounter 4]\"" nonewline
  211.         }
  212.       }
  213.     }
  214.   }
  215.   puts $xfOutFile ""
  216. }
  217.  
  218. ##########
  219. # Procedure: XFTkEmacsSetTkEmacs4
  220. # Description: set tkEmacs parameters
  221. # Arguments: xfW - the widget
  222. #            xfType - the type of setting (1 = set always, 0 = set
  223. #                     only if permanent apply is on)
  224. #            xfClass - the class we configure
  225. #            xfParam1 - ignored parameter
  226. # Returns: none
  227. # Sideeffects: none
  228. ##########
  229. proc XFTkEmacsSetTkEmacs4 {xfW xfType xfClass {xfParam1 ""}} {
  230.   global xfConf
  231.   global xfMisc
  232.  
  233.   if {$xfType == 0 && !$xfConf(applyParameters)} {
  234.     return
  235.   }
  236.   XFMiscSetSymbolicName $xfW \
  237.     [.xf${xfClass}Config4.params1.params2.symname.symname get]
  238.  
  239.   set tmpOptions ""
  240.   append tmpOptions \
  241.     " -useadvise $xfMisc(useAdvise)"
  242.   if {"[.xf${xfClass}Config4.params1.params2.bg.bg get]" != ""} {
  243.     append tmpOptions \
  244.       " -background \"[.xf${xfClass}Config4.params1.params2.bg.bg get]\""
  245.   }
  246.   append tmpOptions \
  247.     " -command \"[.xf${xfClass}Config4.params1.params2.command.command get]\""
  248.   if {"[.xf${xfClass}Config4.params1.params2.file.file get]" != ""} {
  249.     append tmpOptions \
  250.       " -file \"[.xf${xfClass}Config4.params1.params2.file.file get]\""
  251.   }
  252.   if {"[.xf${xfClass}Config4.params1.params2.font.font get]" != ""} {
  253.     append tmpOptions \
  254.       " -font \"[.xf${xfClass}Config4.params1.params2.font.font get]\""
  255.   }
  256.   if {"[.xf${xfClass}Config4.params1.params2.fg.fg get]" != ""} {
  257.     append tmpOptions \
  258.       " -foreground \"[.xf${xfClass}Config4.params1.params2.fg.fg get]\""
  259.   }
  260.   append tmpOptions \
  261.     " -height \"[.xf${xfClass}Config4.params1.params2.size.size2.size2 get]\""
  262.   append tmpOptions \
  263.     " -width \"[.xf${xfClass}Config4.params1.params2.size.size1.size1 get]\""
  264.   if {"[.xf${xfClass}Config4.params1.params2.xscrollcommand.xscrollcommand get]" != ""} {
  265.     append tmpOptions \
  266.       " -xscrollcommand \"[.xf${xfClass}Config4.params1.params2.xscrollcommand.xscrollcommand get]\""
  267.   } {
  268.     append tmpOptions \
  269.       " -xscrollcommand NoFunction"
  270.   }
  271.   if {"[.xf${xfClass}Config4.params1.params2.yscrollcommand.yscrollcommand get]" != ""} {
  272.     append tmpOptions \
  273.       " -yscrollcommand \"[.xf${xfClass}Config4.params1.params2.yscrollcommand.yscrollcommand get]\""
  274.   } {
  275.     append tmpOptions \
  276.       " -yscrollcommand NoFunction"
  277.   }
  278.   if {[catch "$xfW configure $tmpOptions" xfResult]} {
  279.     XFProcError "$xfW\n$xfResult"
  280.   }
  281. }
  282.  
  283. # eof
  284.  
  285.